module BASICCodeGenerator

open BASICAST

open System.Collections.Generic


(*

let CILTypes = Map.ofList [(BoolType, "bool");
                           (IntType, "int32")]

let genDecls symbolTable = 
     symbolTable
        |> Map.toList
        |> List.map 
            (fun (key, value) -> 
                sprintf 
                    "\t\t.locals init (%s '%s')\n" 
                    (Map.find value CILTypes)
                    key)
        |> String.concat ""
        
let genInt numVal =
    if numVal <= 8 then
        sprintf "\t\tldc.i4.%i\n" numVal
    elif numVal <= 127 then
        sprintf "\t\tldc.i4.s %i\n" numVal
    else
        sprintf "\t\tldc.i4 %i\n" numVal 
        
let rec genBinOp op expr1 expr2 =
    sprintf
        "%s%s\t\t%s\n"
        (genExpr expr1)
        (genExpr expr2)
        op                         

and genExpr expr =
    match expr with
    
    | Identifier (lineNum, varName) ->
        sprintf "\t\tldloc '%s'\n" varName
        
    | Integer (_, numVal) -> genInt numVal
    
    | Boolean (_, boolVal) ->
        sprintf "\t\tldc.i4.%i\n" (if boolVal then 1 else 0)

    | Neg (_, expr1) ->
        sprintf "\t\tldc.i4.0\n%s\t\tsub.ovf\n" (genExpr expr1)
        
    | And (lineNum, expr1, expr2) ->
        genBinOp "and" expr1 expr2
          
    | Less (lineNum, expr1, expr2) ->
        genBinOp "clt" expr1 expr2
        
    | Plus (lineNum, expr1, expr2) ->
        genBinOp "add.ovf" expr1 expr2
        
    | Times (lineNum, expr1, expr2) ->
        genBinOp "mul.ovf" expr1 expr2
            
let genAssign varName expr =
    sprintf "%s\t\tstloc '%s'\n" (genExpr expr) varName
    
let genPrint typeRef expr =
    sprintf 
        "%s\t\tcall void class ['bcuplib']'Buttercup'.'Utils'::'Print'(%s)\n"
        (genExpr expr)
        (Map.find !typeRef CILTypes)
     
let genLabel = 
    let labelCount = ref 0
    fun () ->
        incr labelCount
        sprintf "$%06d" !labelCount 
    
let rec genCondition expr stmtList =
    let label = genLabel()
    sprintf
        "%s\t\tbrfalse '%s'\n%s\t'%s':\n"
        (genExpr expr)
        label
        (genStmts stmtList)
        label
         
and *)

let mutable uid = 0;
let getUid x =
    uid <- uid + 1
    sprintf "UI_%i" uid


let mutable functionTable = Map.empty


let rec genExpr expr =
    let mutable res = ""
    match expr with
    | Number (_, numi) -> 
        res <- res + sprintf "\t\tldc.r8 %s\n" (string numi)
    |Identifier (_, sVar)-> 
        res <- res + sprintf "\t\tldloc 'S_%s'\n" sVar
    |IdentifierList (_, id, exp)-> 
        res <- res + sprintf "\t\tldloc 'A_%c'\n" id
        res <- res + genExpr exp
        res <- res + "\t\tconv.i4\n"
        res <- res + "\t\tldelem.r8\n"
        res <- res
    |IdentifierTable (_, id, expa, expb) ->
        res <- res + sprintf "\t\tldloc 'M_%c'\n" id
        res <- res + genExpr expa
        res <- res + "\t\tconv.i4\n"
        res <- res + genExpr expb
        res <- res + "\t\tconv.i4\n"
        res <- res + "\t\tcall instance float64 float64[,]::Get(int32, int32)\n"
    |FunId (_,_) ->
        res <- "\t\tldc.r8 333333\n"
    |Minus (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tsub\n"
    |Plus (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tadd\n"
    |Times (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tmul\n"
    |Div (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tdiv\n"
    |Pow (_, pbase, power) ->
        res <- res + genExpr pbase
        res <- res + "\t\tcall float64 class [mscorlib]System.Math::Abs(float64)\n"
        res <- res + genExpr power
        res <- res + "\t\tcall float64 class [mscorlib]System.Math::Pow(float64, float64)\n"
    |MinEq (_, expa, expb) ->
        res <- res + genExpr expb
        res <- res + genExpr expa
        res <- res + "\t\tcgt.un\n"
    |MaxEq (_, expa, expb) ->
        res <- res + genExpr expb
        res <- res + genExpr expa
        res <- res + "\t\tclt.un \n"
    |NotEq (_, expa, expb) ->
        res <- res + "\t\tldc.i4.1\n"
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tceq\n"
        res <- res + "\t\tneg\n"
        res <- res + "\t\tadd\n"
    |Equal (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tceq\n"
    |Min (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tclt.un\n"
    |Max (_, expa, expb) ->
        res <- res + genExpr expa
        res <- res + genExpr expb
        res <- res + "\t\tcgt.un \n"
    |StdFun (_, key, exp) ->
        res <- res + genExpr exp
        match key with
        | "SIN" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Sin(float64)\n"
        | "COS" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Cos(float64)\n"
        | "TAN" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Tan(float64)\n"
        | "ATN" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Atan(float64)\n"
        | "EXP" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Exp(float64)\n"
        | "ABS" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Abs(float64)\n"
        | "LOG" -> 
            res <- res + "\t\tcall float64 class [mscorlib]System.Math::Abs(float64)\n"
            res <- res + "\t\tcall float64 class [mscorlib]System.Math::Log(float64)\n"
        | "SQR" -> 
            res <- res + "\t\tcall float64 class [mscorlib]System.Math::Abs(float64)\n"
            res <- res + "\t\tcall float64 class [mscorlib]System.Math::Sqrt(float64)\n"
        | "RND" ->
            res <- res + "\t\tpop\n" 
            res <- res + "\t\tldloc 'randcs'\n"
            res <- res + "\t\tcallvirt instance float64 class [mscorlib]System.Random::NextDouble()\n"
        | "INT" -> res <- res + "\t\tcall float64 class [mscorlib]System.Math::Floor(float64)\n"
        | _ -> res <- ""
    |UsrFun (_, key, exp) ->
        let (variab, expA) = functionTable.[key]  
        res <- res + genExpr exp
        res <- res + sprintf "\t\tstloc 'S_%s'\n" variab
        res <- res + genExpr expA
    res



let genScalarLet label id expr =
    sprintf "\t'$%d':\n%s\t\tstloc 'S_%s'\n" label (genExpr expr) id
    
let genArrayLet label id index expr = 
    sprintf "\t'$%d':\n\t\tldloc 'A_%s'\n%s\t\tconv.i4\n%s\t\tstelem.r8\n" label id (genExpr index) (genExpr expr)

let genMatrixLet label id i1 i2 expr =
    sprintf "\t'$%d':\n\t\tldloc 'M_%s'\n%s\t\tconv.i4\n%s\t\tconv.i4\n%s\t\tcall instance void float64[,]::Set(int32, int32, float64)\n" label id (genExpr i1) (genExpr i2) (genExpr expr)

let genStop label =
    sprintf "\t'$%d':\n\t\tldc.i4.0\n\t\tcall void class [mscorlib]System.Environment::Exit(int32)\n" label

let genOnlyLabel label = 
    sprintf "\t'$%d':\n" label
    
let genEnd label =
    sprintf "\t'$%d':\n\t\tret\n" label

let compOp op =
    match op with
    | ">" -> "bgt" 
    | "<" -> "blt"
    | "<=" -> "ble"
    | ">=" -> "bge"
    | "=" -> "beq"
    | "<>" -> "bne.un"
    | _ -> ""
    
let genIf label expr1 op expr2 jump = 
    sprintf "\t'$%d':\n%s%s\t\t%s '$%d'\n" label (genExpr expr1) (genExpr expr2) (compOp op) jump

let genRead label readList =
    let mutable str = (sprintf "\t'$%d':\n" label)
    for read in readList do
        match read with
        | (id, None, None) -> str <- str + (sprintf "\t\tldloc 'DataQueue'\n\t\tcall float64 class ['basiclib']'Basic'.'Utils'::'Read'(class [System]System.Collections.Generic.Queue`1<float64>)\n\t\tstloc 'S_%s'\n" id) 
        | (id, Some(exp), None) -> str <- str + (sprintf "\t\tldloc 'A_%s'\n%s\t\tconv.i4\n\t\tldloc 'DataQueue'\n\t\tcall float64 class ['basiclib']'Basic'.'Utils'::'Read'(class [System]System.Collections.Generic.Queue`1<float64>)\n\t\tstelem.r8\n" id (genExpr exp))
        | (id, Some(exp1), Some(exp2)) -> str <- str + (sprintf "\t\tldloc 'M_%s'\n%s\t\tconv.i4\n%s\t\tconv.i4\n\t\tldloc 'DataQueue'\n\t\tcall float64 class ['basiclib']'Basic'.'Utils'::'Read'(class [System]System.Collections.Generic.Queue`1<float64>)\n\t\tcall instance void float64[,]::Set(int32, int32, float64)\n" id (genExpr exp1) (genExpr exp2))
        | _ -> str <- str + "ESTO SERIA UN GRAVE PROBLEMA"
    str
    
let genGoTo label jump =
    sprintf "\t'$%d':\n\t\tbr '$%d'\n" label jump
    
let toIntConst b =
    match b with
    | true -> 1
    | flase -> 0

let genPrint label (printList : (string option * Expr option * bool) list)=
    let mutable str = (sprintf "\t'$%d':\n" label)
    for print in printList do
        match print with
        | (Some(msg),None, comma) -> str <- str + (sprintf "\t\tldstr %s\n\t\tldc.i4.%d\n\t\tcall void class ['basiclib']'Basic'.'Utils'::'Print'(string, bool)\n" msg (toIntConst comma) )
        | (None, Some(expr), comma) -> str <- str + (sprintf "\t\tldstr \"\"\n%s\t\tldc.i4.%d\n\t\tcall void class ['basiclib']'Basic'.'Utils'::'Print'(string, float64, bool)\n" (genExpr expr) (toIntConst comma) )
        | (Some(msg), Some(expr), comma) -> str <- str + (sprintf "\t\tldstr %s\n%s\t\tldc.i4.%d\n\t\tcall void class ['basiclib']'Basic'.'Utils'::'Print'(string, float64, bool)\n" msg (genExpr expr) (toIntConst comma) )
        | _ -> str <- str + "HAY ALGO MAL"
    if printList.IsEmpty then
        str <- str + "\t\t ldstr \"\"\n\t\tcall void class [mscorlib]System.Console::WriteLine(string)\n"
    else
        let ultimo = printList.Item(printList.Length - 1)
        match ultimo with
        | (_,_,false) -> str <- str + "\t\t ldstr \"\"\n\t\tcall void class [mscorlib]System.Console::WriteLine(string)\n"
        | (_,_,true) -> str <- str + ""
    str
   

let forNextStack = new Stack<(int*string*Expr*Expr)>()
 

let setFor label varId expa expb someExpc = 
    let mutable res = ""
    res <- res + sprintf "\t'$%d':\n" label
    res <- res + genExpr expa 
    res <- res + sprintf "\t\tstloc 'S_%s'\n" (string varId)
    res <- res + sprintf "\t\tbr '$M%d'\n" label
    res <- res + sprintf "\t'F%d': \n" label
    match someExpc with
    |Some(expc) -> forNextStack.Push(label, varId, expb, expc)
    |None -> forNextStack.Push(label, varId, expb, Number(1,1.0))
    res

let setNext labl varIdn = 
    let mutable res = ""
    res <- res + sprintf "\t'$%d':\n" labl
    let (label, varIdf, comparsion, step) = forNextStack.Pop()
    res <- res + sprintf "\t\tldloc 'S_%s'\n" (string varIdn) 
    res <- res + genExpr step
    res <- res + "\t\tadd\n"
    res <- res + sprintf "\t\tstloc 'S_%s'\n" (string varIdn)
    res <- res + sprintf "\t'$M%d':\n" label
    res <- res + sprintf "\t\tldloc 'S_%s'\n" (string varIdn)
    res <- res + genExpr comparsion
    res <- res + sprintf "\t\tble 'F%d'\n" label
    res
    
    
let mutable returnStack = Set.empty

let setGoSub origin dest = 
    let mutable res = ""
    res <- res + sprintf "\t '$%d'  :\n" origin
    res <- res + "\t\t ldloc 'returnStack'\n"
    res <- res + "\t\t ldc.i4.1\n"
    res <- res + "\t\t add\n"
    res <- res + "\t\t stloc 'returnStack' \n"
    res <- res + "\t\tldloc 'DataStack'\n"
    res <- res + sprintf "\t\t ldc.i4 %d\n" origin
    res <- res + "\t\tcallvirt instance void class [System]System.Collections.Generic.Stack`1<int32>::Push(!0)\n"
    res <- res + sprintf "\t\t br '$%d'\n" dest
    res <- res + sprintf "\t '$$%d' :\n" origin
    returnStack <- returnStack.Add origin
    res

let setReturn label =
    let mutable res = ""
    res <- res + sprintf "\t '$%d'  :\n" label
    res <- res + "\t\t ldloc 'returnStack'\n"
    res <- res + "\t\t ldc.i4.1\n"
    res <- res + "\t\t sub\n"
    res <- res + "\t\t stloc 'returnStack'\n"
    res <- res + "\t\t ldloc 'returnStack'\n"
    res <- res + "\t\t ldc.i4.0\n"  
    res <- res + "\t\t blt 'endLabel'\n"
    res <- res + "\t\t br 'returnFun'\n"
    res

let genReturnFun dummy =
    let mutable res = ""
    res <- res + "\t 'returnFun' :\n"
    res <- res + "\t\tldloc 'DataStack'\n"
    res <- res + "\t\tcallvirt instance !0 class [System]System.Collections.Generic.Stack`1<int32>::Pop()\n"
    res <- res + "\t\tstloc 'powRes'\n"
    for label in returnStack do
        res <- res + "\t\tldloc 'powRes'\n"
        res <- res + sprintf "\t\tldc.i4 %d\n" label
        res <- res + sprintf "\t\tbeq  '$$%d'\n" label
    res



let genStmt stmt =
    
    match stmt with 
    | LetVar (_,label,id,expr) -> genScalarLet label id expr
    | LetList (_,label,id,indexExpr,expr) -> genArrayLet label (string id) indexExpr expr
    | LetTable (_,label,id,i1Expr,i2Expr, expr) -> genMatrixLet label (string id) i1Expr i2Expr expr
    | Rem(_,label) -> genOnlyLabel label
    | Stop (_,label) -> genStop label
    | End (_,label) -> genEnd label
    | If (_,label, expr1, op, expr2, jump) -> genIf label expr1 op expr2 jump
    | Read (_, label, readList) -> genRead label readList
    | Data (_, label, _) -> genOnlyLabel label
    | Goto (_, label, jump) -> genGoTo label jump
    | Def (_, label,_,_,_) -> genOnlyLabel label
    | Dim (_, label, _) -> genOnlyLabel label
    | Print (_, label, printList) -> genPrint label printList
    | For (_, label, varId, expa, expb, someExpc) -> setFor label varId expa expb someExpc
    | Next (_, label, varId) -> setNext label varId
    | GoSub (_, origin, dest) -> setGoSub origin dest
    | Return (_, label) -> setReturn label
        
let genStmts stmtList =
    stmtList
    |> List.map genStmt
    |> String.concat ""

let genScalarDec scalarTable =
    scalarTable    
             |> Set.toList
             |> List.map
                (fun scalar ->
                    sprintf 
                        "\t\t.locals init (float64 'S_%s')\n"
                        scalar)
             |> String.concat ""
    
let genArrayDec arrayTable =     
    arrayTable
             |> Map.toList
             |> List.map
                (fun (id,_) ->
                    sprintf 
                        "\t\t.locals init (float64[] 'A_%s')\n"
                        id)
             |> String.concat "" 

let genMatrixDec matrixTable =      
    matrixTable
             |> Map.toList
             |> List.map
                (fun (id,_) ->
                    sprintf 
                        "\t\t.locals init (float64[,] 'M_%s')\n"
                        id)
             |> String.concat ""

let genDecls symbolTable =
     let scalarTable, arrayTable, matrixTable, _ = symbolTable
     (genScalarDec scalarTable) + (genArrayDec arrayTable) + (genMatrixDec matrixTable)
     
let genInitArray arrayTable =      
    arrayTable
             |> Map.toList
             |> List.map
                (fun (id,size) ->
                    sprintf 
                        "\t\tldc.i4 %d\n\t\tnewarr [mscorlib]System.Double \n\t\tstloc 'A_%s'\n"
                        (size + 1)
                        id)
             |> String.concat ""

let genInitMatrix matrixTable =      
    matrixTable
             |> Map.toList
             |> List.map
                (fun (id,(w,h)) ->
                    sprintf 
                        "\t\tldc.i4 %d\n\t\tldc.i4 %d\n\t\tnewobj instance void float64[,]::'.ctor'(int32, int32)\n\t\tstloc 'M_%s'\n"
                        (w + 1)
                        (h + 1)
                        id)
             |> String.concat ""
     
let genInit symbolTable =
   let _, arrayTable, matrixTable, _ = symbolTable
   (genInitArray arrayTable) + (genInitMatrix matrixTable)
   
let populateDataQueue dataList =   
    let mutable str = ""
    for data in dataList do
        str <- str + (sprintf "\t\tldloc 'DataQueue'\n\t\tldc.r8 %f\n\t\tcallvirt instance void class [System]System.Collections.Generic.Queue`1<float64>::Enqueue(!0)\n" data)
    str
    
let genDataQueue dataList =
    "\t\tnewobj instance void class [System]System.Collections.Generic.Queue`1<float64>::'.ctor'()\n\t\tstloc 'DataQueue'\n"
    + (populateDataQueue dataList)
    + "\t\tnewobj instance void class [System]System.Collections.Generic.Stack`1<int32>::'.ctor'()\n\t\tstloc 'DataStack'\n"
    + "\t\tnewobj instance void class [mscorlib]System.Random::'.ctor'()\n\t\tstloc 'randcs'\n"
    

    
let generateCode symbolTable dataList parseTree =
    let (_,_,_,defFuncs) = symbolTable
    functionTable <- defFuncs
    match parseTree with 
        | Program (stmtList) -> 
            let prologue =
                "// Code generated by the basic compiler.\n\n"
                + ".assembly 'basic' {}\n\n"
                + ".assembly extern 'basiclib' {}\n\n"
                + ".assembly extern System{\n\t.ver 4:0:0:0\n\t.publickeytoken = (B7 7A 5C 56 19 34 E0 89 )\n}\n"
                + ".assembly extern mscorlib{\n\t.ver 4:0:0:0\n\t.publickeytoken = (B7 7A 5C 56 19 34 E0 89 )\n}\n\n"
                + ".class public 'BasicProgram' extends "
                + "['mscorlib']'System'.'Object' {\n"
                + "\t.method public static void 'start'() {\n"
                + "\t\t.entrypoint\n"
                + "\t\t.maxstack 1024\n"
                + "\t\t.locals init (int32 'powRes')\n"
                + "\t\t.locals init (int32 'returnStack')\n"
                + "\t\t.locals init (class [mscorlib]System.Random 'randcs')\n"
                + "\t\t.locals init (class [System]System.Collections.Generic.Queue`1<float64>	'DataQueue')\n"
                + "\t\t.locals init (class [System]System.Collections.Generic.Stack`1<int32>	'DataStack')\n"
            let epilogue =      
                 "\t 'endLabel' :\n"
                + "\t\tldstr \"RuntimeError: Found RETURN with no GOSUB\"\n\t\tcall void class [mscorlib]System.Console::WriteLine(string)\n\t\tldc.i4.1\n\t\tcall void class [mscorlib]System.Environment::Exit(int32)\n\t\tret\n"        
                + "\t}\n"
                + "}"
            prologue
                + (genDecls symbolTable) 
                + (genInit symbolTable)
                + (genDataQueue dataList)
                + (genStmts stmtList)
                + (genReturnFun 2)
                + epilogue
